home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / csd.em < prev    next >
Text File  |  1993-07-09  |  1KB  |  49 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: csd.em
  4. ;; Date: Fri Jul  9 00:15:44 1993
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;   classed-local-slot-descriptions
  9.  
  10. (defmodule csd
  11.   (standard0
  12.    list-fns
  13.    
  14.    )
  15.   ()
  16.   
  17.   (defclass <classed-local-slot-description> (<local-slot-description>)
  18.     ((contents-class initform <object> initarg contents-class
  19.              reader classed-local-slot-description-contents-class))
  20.     metaclass <slot-description-class>)
  21.  
  22.   (defmethod compute-primitive-writer-using-slot-description 
  23.     ((csd <classed-local-slot-description>) cl lst)
  24.     (let ((std-writer (call-next-method))
  25.       (contents-cl (classed-local-slot-description-contents-class csd)))
  26.       (lambda (obj val)
  27.     (format t "In write: ~a, ~a~%" obj val)
  28.     (if (subclassp (class-of val) contents-cl)
  29.         (std-writer obj val)
  30.       (error "invalid class of value for slot"
  31.          some-error 'object obj 'sd csd 'val val)))))
  32.  
  33.   (defclass <person> ()
  34.     ((age slot-class <classed-local-slot-description>
  35.       initarg age
  36.       slot-initargs ('contents-class <integer>) accessor age)
  37.      (name slot-class <classed-local-slot-description>
  38.        slot-initargs ('contents-class <string>)
  39.        accessor name) 
  40.      (ordinary-slot initform 'bleagh))
  41.     )
  42.   
  43.  
  44.   ;; (make <person> 'age 24 'name "Pete Broadbery")
  45.   ;; (make <person> 'age 'wibble 'name 22)
  46.  
  47.   ;; end module
  48.   )
  49.